;solution for euler 217
;incomplete

(defun ^ (x y)
           (when (= 0 y) (return-from ^ 1))
           (return-from ^ (* x (^ x (- y 1))))) 

(defun digitcount (x)
  (return-from digitcount 
    (+ 
     (floor 
      (/ 
       (log x) (log 10))) 1)))


(defun balanced (x)
         (if (= x 0)
              (return-from balanced t))
	(let (
              (suml 0) 
              (sumr 0) 
              (lm (floor (/ (digitcount x) 2)))
              (hm (ceiling (/ (digitcount x) 2))))
          (dotimes (j lm)
            (setf sumr (+ sumr (mod x 10)))
            (setf x (floor (/ x 10))))
          (if (> hm lm)
              (setf x (floor (/ x 10))))
          (dotimes (j lm)
            (setf suml (+ suml (mod x 10)))
            (setf x (floor (/ x 10))))
          ;(format t "lsum: ~a rsum: ~a lm: ~a hm: ~a" suml sumr lm hm)
          (return-from balanced 
            (cond ((= sumr suml) t)
                ((/= sumr suml) nil)))))

;modification of (balanced x)
;assumes x to have digitcount digits
(defun balanced-with-digits (x digitcount)
         (if (= x 0)
              (return-from balanced-with-digits t))
	(let (
              (suml 0) 
              (sumr 0) 
              (lm (floor (/ digitcount 2)))
              (hm (ceiling (/ digitcount 2))))
          (dotimes (j lm)
            (setf sumr (+ sumr (mod x 10)))
            (setf x (floor (/ x 10))))
          (if (> hm lm)
              (setf x (floor (/ x 10))))
          (dotimes (j lm)
            (setf suml (+ suml (mod x 10)))
            (setf x (floor (/ x 10))))
          ;(format t "lsum: ~a rsum: ~a lm: ~a hm: ~a" suml sumr lm hm)
          (return-from balanced-with-digits 
            (cond ((= sumr suml) t)
                ((/= sumr suml) nil)))))


(defun count-digit (num dig)
  (let ((count 0))
    (loop
     (when (= num 0) 
       (return-from count-digit count))
     (when (= (mod num 10) dig)
       (setf count (+ count 1)))
     (setf num (floor (/ num 10))))))

;sum balanced numbers under given x
(defun sum-balanced (x)
  (let ((sum 0))
    (dotimes (j x)
      (if (balanced j)
          (setf sum (+ sum j))))
    (return-from sum-balanced sum)))


;used to explore if all digits have the same frequency in balanced numbers
;for all balanced numbers under 100, and all under 1000, true
;false for all under 10000, 100000, and probably beyond
(defun counting-test (x)
  (let ((digit-count (digitcount (- x 1)))
        (counts (make-array 10 :initial-element 0)))
    (dotimes (j x)
      (when (balanced-with-digits j digit-count)
        (dotimes (i 10)
          (setf (elt counts i) (+ (elt counts i) (count-digit j i))))))
    (dotimes (i 10)
      (format t "~a-count: ~a~%" i (elt counts i)))))


(defun counting-test2 (x)
  (let ((digit-count (digitcount (- x 1)))
        (counts (make-array 10 :initial-element 0))
        (sum 0)
        val)
    (dotimes (j x)
      (when (balanced j)
        (incf sum j)
        (setf val j)
        (loop
         (when (= 0 val) (return))
         (incf (elt counts (mod val 10)))
         (setf val (floor (/ val 10))))))
    (format t "~%Sum: ~a~%" sum)
    (dotimes (i 10)
      (format t "~a-count: ~a~%" i (elt counts i)))))

(defun long-test ()
  (let ((n 10))
    (dotimes (i 5)
      (time (counting-test2 n))
      (setf n (* 10 n)))))

(defun distance-test (n)
  (let ((prev 0)
        (out (open "balanced-distances.txt" :direction :output :if-exists :supersede)))
    (dotimes (i n)
      (when (balanced i)
        (when (/= (- i prev) 9)
          (format out "~a,~a~%" i (- i prev)))
        (setf prev i)))
    (close out)))


